home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 1 / ETO Development Tools 1.iso / Essentials / Developer Essentials Jul 90 / Programming / MPW Interfaces & Libraries 3.1 / AIncludes / ObjMacros.a < prev    next >
Encoding:
Text File  |  1989-10-13  |  10.8 KB  |  488 lines  |  [TEXT/MPS ]
  1. ; Version: 2.65
  2. ; Created: Saturday, September 16, 1989 at 5:02:39 PM
  3. ;
  4. ; File: ObjMacros.a
  5. ;
  6. ; Assembler Interface to the Macintosh Libraries
  7. ; Copyright Apple Computer, Inc. 1986-1988
  8. ; All Rights Reserved.
  9. ;
  10. ;--------------------------------------------------------------------
  11. ; This file contains:
  12. ; Macros to support Object Assembler
  13. ; The InitObjects macro
  14. ; A template for TObject, the suggested root class for all objects
  15. ;
  16. ; The usable Macros in this file are documented in both the Assembler
  17. ; and MacApp manuals. Those macros are:
  18. ;
  19. ; ObjectDef
  20. ; ObjectIntf
  21. ; ObjectWith
  22. ; EndObjectWith
  23. ; ProcMethOf
  24. ; FuncMethOf
  25. ; EndMethod
  26. ; MethCall
  27. ; Inherited
  28. ; MoveSelf
  29. ; NewObject
  30. ; InitObjects
  31. ;
  32. ;
  33. ; Current limitations:
  34. ; 250 classes
  35. ; unlimited methods
  36. ;
  37. ; Object assembler programmers who do not use a Pascal main program
  38. ; MUST call the InitObjects macro at the beginning of their program.
  39. ;--------------------------------------------------------------------
  40. ;
  41. ; Modification history:
  42. ; *** MPW 2.0 ***
  43. ;--------------------------------------------------------------------
  44.  
  45.  
  46.  
  47.  IMPORT %_METHOD
  48.  IMPORT %_OBNEW
  49.  IF &TYPE('ObjOptFlag') = 'UNDEFINED' THEN
  50. ObjOptFlag: EQU 0
  51.  ENDIF
  52.  IF &TYPE('DebugFlag') = 'UNDEFINED' THEN
  53. DebugFlag: EQU 1
  54.  ENDIF
  55.  
  56.  
  57.  MACRO
  58.  REFSELECTOR &ProcName,&ItsObjIndex,&OpCode
  59.  
  60.  GBLA &ObjSupers[250],&MethLists[250], &MethTable
  61.  GBLC &ObjNames[250]
  62.  
  63.  LCLA &start,&found,&objIndex,&LexInt
  64.  
  65.  &found: SETA 0
  66.  IF &FINDSYM(&MethTable,&ProcName) THEN
  67.  &start: SETA 1
  68.  GOTO .EndLoop
  69.  WHILE &SYSTOKEN <> 30 DO
  70.  &LexInt: SETA &S2I(&SYSTOKSTR)
  71.  &objIndex: SETA &ItsObjIndex
  72.  WHILE (&objIndex <> 0) DO
  73.  IF &LexInt = &objIndex THEN
  74.  &OpCode &ObjNames[&objIndex]$&ProcName
  75.  &objIndex: SETA 0
  76.  &found: SETA 1
  77.  ELSE
  78.  &objIndex: SETA &ObjSupers[&objIndex]
  79.  ENDIF
  80.  ENDWHILE
  81. .EndLoop
  82.  &start: SETA &LEX(&SYSVALUE, &start)
  83.  WHILE (&SYSTOKEN <> 1) AND (&SYSTOKEN <> 30) DO
  84.  &start: SETA &LEX(&SYSVALUE, &start)
  85.  ENDWHILE
  86.  ENDWHILE
  87.  ENDIF
  88.  
  89.  IF &found = 0 THEN
  90.  AERROR &Concat('Error trying to reference method: ',&ProcName)
  91.  ENDIF
  92.  
  93.  ENDMACRO
  94.  
  95.  MACRO
  96.  SELECTORPROC &ProcName
  97.  LCLC &SaveSeg
  98.  &SaveSeg: SETC &SYSSEG
  99.  SEG '%_SelProcs'
  100.  &ProcName: PROC EXPORT
  101.  JSR %_METHOD
  102.  ENDPROC
  103.  SEG '&SaveSeg'
  104.  ENDMACRO
  105.  
  106.  
  107.  
  108.  MACRO
  109.  ObjectTemplate &TypeName,&Heritage=NIL,&IntfOnly:INT=0
  110.  
  111.  GBLA &ObjSupers[250],&MethLists[250]
  112.  GBLC &ObjNames[250]
  113.  GBLA &lastObjIndex, &currMethIndex, &MethTable
  114.  
  115.  GBLA &NumFields,&NumMethods
  116.  GBLC &FieldList[250],&MethodList[250]
  117.  
  118.  LCLA &methNum, &fieldNum, &objIndex
  119.  LCLC &SaveSeg, &RootIndex
  120.  LCLA &SuperIndex, &NumChars, &Temp
  121.  LCLA &methIndex, &foundIndex, &MethFlag, &SymReturn
  122.  
  123.  LCLC &TempArray[1],&CurrField[2],&CurrMethod[3]
  124.  
  125.  IF &MethTable = 0 THEN
  126.  &MethTable: SETA &NEWSYMTBL
  127.  ENDIF
  128.  
  129.  &lastObjIndex: SETA &lastObjIndex+1
  130.  &ObjNames[&lastObjIndex]: SETC &TypeName
  131.  &MethLists[&lastObjIndex]: SETA &currMethIndex+1
  132.  IF (&Heritage = 'NIL') THEN
  133.  &ObjSupers[&lastObjIndex]: SETA 0
  134.  ELSE
  135.  &SuperIndex: SETA 1
  136.  &ObjNames[&lastObjIndex+1]: SETC &Heritage
  137.  WHILE (&ObjNames[&SuperIndex] <> &Heritage) DO
  138.  &SuperIndex: SETA &SuperIndex+1
  139.  ENDWHILE
  140.  IF (&SuperIndex > &lastObjIndex) THEN
  141.  AERROR &Concat('Non-existent Ancestor Object Type: ',&Heritage)
  142.  ELSE
  143.  &ObjSupers[&lastObjIndex]: SETA &SuperIndex
  144.  ENDIF
  145.  ENDIF
  146.  
  147.  IF &NumFields >= 0 THEN
  148.  &fieldNum: SETA 1
  149.  %&TypeName: RECORD &Heritage.Offset
  150.  WHILE &fieldNum <= &NumFields DO
  151.  &NumChars: SETA &LEN(&FieldList[&fieldNum])-2
  152.  &Temp: SETA &LIST(&FieldList[&fieldNum,2:&NumChars], '&CurrField')
  153.  IF &Eval(&CurrField[2]) >= 2 THEN
  154.  ALIGN 2
  155.  ENDIF
  156.  &CurrField[1]: DS.B &CurrField[2]
  157.  &fieldNum: SETA &fieldNum+1
  158.  ENDWHILE
  159.  ALIGN 2
  160.  last: EQU *
  161.  ENDR
  162.  &TypeName.Offset: EQU %&TypeName..last
  163.  ENDIF
  164.  
  165.  IF &NumMethods > 0 THEN
  166.  &methNum: SETA 1
  167.  WHILE &methNum <= &NumMethods DO
  168.  &NumChars: SETA &LEN(&MethodList[&methNum])-2
  169.  &CurrMethod[2]: SETC ''
  170.  &CurrMethod[3]: SETC ''
  171.  &Temp: SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  172.  IF (&CurrMethod[2] = '') OR (&UC(&CurrMethod[2]) = 'IMPL') THEN
  173.  IF (&UC(&CurrMethod[2]) = 'IMPL') THEN
  174.  IF &IntfOnly THEN
  175.  IMPORT &TypeName.$&CurrMethod[1]
  176.  ELSE
  177.  AERROR &Concat('IMPL only allowed in ObjectIntf Macro. Error at ', \
  178.  &CurrMethod[1],' in ',&TypeName)
  179.  ENDIF
  180.  ELSEIF &IntfOnly THEN
  181.  IMPORT &TypeName.$&CurrMethod[1]
  182.  ELSE
  183.  SELECTORPROC &TypeName.$&CurrMethod[1]
  184.  ENDIF
  185.  &currMethIndex: SETA &currMethIndex+1
  186.  &SymReturn: SETA &ENTERSYM(&MethTable,&I2S(&currMethIndex),&CurrMethod[1],0)
  187.  
  188. * First do findsym to see if other unrelated root classes
  189.  IF &FINDSYM(&MethTable,&CurrMethod[1]) THEN
  190.  &RootIndex: SETC &Concat(&SYSVALUE,' ',&I2S(&lastObjIndex))
  191.  &MethFlag: SETA &SYSFLAGS+1
  192.  ELSE
  193.  &RootIndex: SETC &I2S(&lastObjIndex)
  194.  &MethFlag: SETA 1
  195.  ENDIF
  196.  &SymReturn: SETA &ENTERSYM(&MethTable,&CurrMethod[1],&RootIndex,&MethFlag)
  197.  ELSEIF (&UC(&CurrMethod[2]) <> 'OVERRIDE') THEN
  198.  AERROR &Concat(&CurrMethod[2],' illegal after ',&CurrMethod[1], \
  199.  ' in ',&TypeName)
  200.  ENDIF
  201.  IF NOT &IntfOnly THEN
  202.  EXPORT &TypeName._&CurrMethod[1]
  203.  ELSEIF (&UC(&CurrMethod[2]) = 'IMPL') OR (&UC(&CurrMethod[3]) = 'IMPL') THEN
  204.  EXPORT &TypeName._&CurrMethod[1]
  205.  ELSE
  206.  IMPORT &TypeName._&CurrMethod[1]
  207.  ENDIF
  208.  &methNum: SETA &methNum+1
  209.  ENDWHILE
  210.  
  211.  IF NOT &IntfOnly THEN
  212.  &SaveSeg: SETC &SYSSEG
  213.  SEG '%_MethTables'
  214.  CODEREFS FORCEJT
  215.  _&TypeName: PROC EXPORT
  216.  DC.W _&TypeName
  217.  IF &Heritage = 'NIL' THEN
  218.  DC.W 0
  219.  ELSE
  220.  DC.W _&Heritage
  221.  ENDIF
  222.  DC.W &TypeName.Offset
  223.  DC.W &methNum-1
  224.  &methNum: SETA 1
  225.  WHILE &methNum <= &NumMethods DO
  226.  &NumChars: SETA &LEN(&MethodList[&methNum])-2
  227.  &CurrMethod[2]: SETC ''
  228.  &CurrMethod[3]: SETC ''
  229.  &Temp: SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  230.  IF (&CurrMethod[2] = '') THEN
  231.  DC.W &TypeName.$&CurrMethod[1]
  232.  ELSEIF (&UC(&CurrMethod[2]) = 'OVERRIDE') THEN
  233.  IF &superIndex = 0 THEN
  234.  AERROR &Concat('Override of Non-existent method: ',&CurrMethod[1])
  235.  ELSE
  236.  REFSELECTOR &CurrMethod[1],&superIndex,DC.W
  237.  ENDIF
  238.  ENDIF
  239.  IMPORT &TypeName._&CurrMethod[1]
  240.  DC.W &TypeName._&CurrMethod[1]
  241.  &methNum: SETA &methNum+1
  242.  ENDWHILE
  243.  ENDPROC
  244.  SEG '&SaveSeg'
  245.  CODEREFS NOFORCEJT
  246.  ELSE
  247.  IMPORT _&TypeName
  248.  ENDIF
  249.  ENDIF
  250.  &MethLists[&lastObjIndex+1]: SETA &currMethIndex+1
  251.  ENDMACRO
  252.  
  253.  
  254.  MACRO
  255.  ObjectDef &TypeName,&Heritage=NIL
  256.  
  257.  GBLA &NumFields,&NumMethods
  258.  GBLC &FieldList[250],&MethodList[250]
  259.  
  260.  LCLA &index1, &index2
  261.  
  262.  &index1: SETA 3
  263.  &index2: SETA 1
  264.  WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
  265.  &FieldList[&index2]: SETC &SYSLIST[&index1]
  266.  &index1: SETA &index1+1
  267.  &index2: SETA &index2+1
  268.  ENDWHILE
  269.  &NumFields: SETA &index2-1
  270.  
  271.  &index2: SETA 1
  272.  IF &SYSLIST[&index1] = 'METHODS' THEN
  273.  &index1: SETA &index1+1
  274.  WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
  275.  &MethodList[&index2]: SETC &SYSLIST[&index1]
  276.  &index1: SETA &index1+1
  277.  &index2: SETA &index2+1
  278.  ENDWHILE
  279.  ENDIF
  280.  &NumMethods: SETA &index2-1
  281.  
  282.  ObjectTemplate &TypeName,&Heritage,0
  283.  ENDMACRO
  284.  
  285.  
  286.  MACRO
  287.  ObjectIntf &TypeName,&Heritage=NIL
  288.  
  289.  GBLA &NumFields,&NumMethods
  290.  GBLC &FieldList[250],&MethodList[250]
  291.  
  292.  LCLA &index1, &index2
  293.  
  294.  &index1: SETA 3
  295.  &index2: SETA 1
  296.  WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
  297.  &FieldList[&index2]: SETC &SYSLIST[&index1]
  298.  &index1: SETA &index1+1
  299.  &index2: SETA &index2+1
  300.  ENDWHILE
  301.  &NumFields: SETA &index2-1
  302.  
  303.  &index2: SETA 1
  304.  IF &SYSLIST[&index1] = 'METHODS' THEN
  305.  &index1: SETA &index1+1
  306.  WHILE &NBR(&SYSLIST[&index1]) <> 0 DO
  307.  &MethodList[&index2]: SETC &SYSLIST[&index1]
  308.  &index1: SETA &index1+1
  309.  &index2: SETA &index2+1
  310.  ENDWHILE
  311.  ENDIF
  312.  &NumMethods: SETA &index2-1
  313.  
  314.  ObjectTemplate &TypeName,&Heritage,1
  315.  ENDMACRO
  316.  
  317.  
  318.  
  319.  MACRO
  320.  OBJECTWITH &TypeName
  321.  GBLA &WithLevel[8]
  322.  GBLA &WithIndex
  323.  GBLA &ObjSupers[*]
  324.  GBLC &ObjNames[*]
  325.  GBLA &lastObjIndex
  326.  
  327.  GBLC &currObjName,&currSuperName
  328.  GBLA &currObjIndex
  329.  
  330.  LCLA &SuperIndex
  331.  &currObjName: SETC &TypeName
  332.  &SuperIndex: SETA 1
  333.  &ObjNames[&lastObjIndex+1]: SETC &TypeName
  334.  WHILE &ObjNames[&SuperIndex] <> &TypeName DO
  335.  &SuperIndex: SETA &SuperIndex+1
  336.  ENDWHILE
  337.  &currObjIndex: SETA &SuperIndex
  338.  IF &SuperIndex > &lastObjIndex THEN
  339.  AERROR &Concat('Object Type name does not exist: ',&TypeName)
  340.  ELSE
  341.  IF &ObjSupers[&SuperIndex] = 0 THEN
  342.  &currSuperName: SETC 'NIL'
  343.  ELSE
  344.  &currSuperName: SETC &ObjNames[&ObjSupers[&SuperIndex]]
  345.  ENDIF
  346.  WITH %&TypeName
  347.  &WithIndex: SETA &WithIndex+1
  348.  WHILE &ObjSupers[&SuperIndex] <> 0 DO
  349.  WITH %&ObjNames[&ObjSupers[&SuperIndex]]
  350.  &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]+1
  351.  &SuperIndex: SETA &ObjSupers[&SuperIndex]
  352.  ENDWHILE
  353.  ENDIF
  354.  ENDMACRO
  355.  
  356.  MACRO
  357.  METHOD &MethName,&TypeName,&FuncORProc=PROC
  358.  &TypeName._&MethName: &FuncORProc EXPORT
  359.  OBJECTWITH &TypeName
  360.  ENDMACRO
  361.  
  362.  MACRO
  363.  &MethName: ProcMethOf &TypeName
  364.  METHOD &MethName,&TypeName,PROC
  365.  ENDMACRO
  366.  
  367.  MACRO
  368.  &MethName: FuncMethOf &TypeName
  369.  METHOD &MethName,&TypeName,FUNC
  370.  ENDMACRO
  371.  
  372.  MACRO
  373.  ObjectEndWith
  374.  ENDWITH
  375.  GBLA &WithLevel[*]
  376.  GBLA &WithIndex
  377.  IF &WithIndex > 0 THEN
  378.  WHILE &WithLevel[&WithIndex] > 0 DO
  379.  ENDWITH
  380.  &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]-1
  381.  ENDWHILE
  382.  &WithIndex: SETA &WithIndex-1
  383.  ENDIF
  384.  ENDMACRO
  385.  
  386.  
  387.  MACRO
  388.  ENDMETHOD
  389.  ObjectEndWith
  390.  ENDPROC
  391.  ENDMACRO
  392.  
  393.  
  394.  MACRO
  395.  METHCALL &MethName,&ObjTypeName
  396.  GBLC &ObjNames[*]
  397.  GBLA &currObjIndex, &lastObjIndex
  398.  
  399.  LCLA &objIndex
  400.  IF &ObjTypeName = '' THEN
  401.  &objIndex: SETA &currObjIndex
  402.  ELSE
  403.  &objIndex: SETA 1
  404.  &ObjNames[&lastObjIndex+1]: SETC &ObjTypeName
  405.  WHILE &ObjNames[&objIndex] <> &ObjTypeName DO
  406.  &objIndex: SETA &objIndex+1
  407.  ENDWHILE
  408.  ENDIF
  409.  IF &objIndex > &lastObjIndex THEN
  410.  AERROR &Concat('Unknown Object type Name: ',&ObjTypeName)
  411.  ELSEIF ObjOptFlag THEN
  412.  JSR &ObjNames[&objIndex]$&MethName
  413.  ELSE
  414.  REFSELECTOR &MethName,&objIndex,JSR
  415.  ENDIF
  416.  ENDMACRO
  417.  
  418.  MACRO
  419.  INHERITED &MethName
  420.  GBLC &ObjNames[*]
  421.  GBLA &ObjSupers[*]
  422.  GBLA &currObjIndex
  423.  
  424.  LCLA &objIndex
  425.  
  426.  &objIndex: SETA &ObjSupers[&currObjIndex]
  427.  WHILE (&TYPE(&Concat(&ObjNames[&objIndex],'_',&MethName)) = 'UNDEFINED') AND (&objIndex <> 0) DO
  428.  &objIndex: SETA &ObjSupers[&objIndex]
  429.  ENDWHILE
  430.  IF &objIndex = 0 THEN
  431.  AERROR &Concat('Inherited error; Method not defined in ancestor: ',&MethName)
  432.  ELSE
  433.  IMPORT &ObjNames[&objIndex]_&MethName
  434.  JSR &ObjNames[&objIndex]_&MethName
  435.  ENDIF
  436.  ENDMACRO
  437.  
  438.  
  439.  MACRO
  440.  MoveSelf &Dest
  441.  MOVE.L 8(A6),&Dest
  442.  ENDMACRO
  443.  
  444.  
  445.  MACRO
  446.  NewObject &Loc,&TypeName,&Size
  447.  PEA &Loc
  448.  PEA _&TypeName+2
  449.  IF &Size = '' THEN
  450.  MOVE.W #&TypeName.Offset,-(SP)
  451.  ELSE
  452.  MOVE.W #&Size,-(SP)
  453.  ENDIF
  454.  JSR %_OBNEW
  455.  ENDMACRO
  456. * The InitObjects macro must be called if the main program is not in Pascal
  457.  
  458.  IMPORT %_PGM1
  459.  
  460.  MACRO
  461.  InitObjects
  462.  
  463.  JSR %_PGM1
  464.  ENDMACRO
  465.  
  466.  
  467. NILOffset EQU 2
  468.  
  469.  IF DebugFlag THEN
  470.  
  471.  ObjectIntf TObject,, \ Suggested root class for all objects
  472.  METHODS, \ no data fields
  473.  (ShallowClone), \ Object copying method; rarely overridden
  474.  (Clone), \ Can be overriden to clone fields
  475.  (ShallowFree), \ Frees object; rarely overridden
  476.  (Free), \ Can be overriden to free fields
  477.  (ClassName), \ Returns name of class
  478.  (Inspect) ; Print info to debug window
  479.  ELSE
  480.  ObjectIntf TObject,, \ Suggested root class for all objects
  481.  METHODS, \ no data fields
  482.  (ShallowClone), \ Object copying method; rarely overridden
  483.  (Clone), \ Can be overriden to clone fields
  484.  (ShallowFree), \ Frees object; rarely overridden
  485.  (Free) ; Can be overriden to free fields
  486.  
  487.  ENDIF
  488.